home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 27 / CU Amiga Magazine's Super CD-ROM 27 (1998)(EMAP Images)(GB)[!][issue 1998-10].iso / CUCD / Programming / JForth / JTools / IFF / packing < prev    next >
Encoding:
Text File  |  1992-01-26  |  4.9 KB  |  233 lines
  1. \ Packing Routines needed by IFF files
  2. \
  3. \ Packs Bitmap into Run-Length-Encoded data.
  4. \ Can be used to Pack IFF data in "cmpByteRun1" form.
  5. \
  6. \ Technique:
  7. \   Normal Data is stored as a positive count followed
  8. \      by N+1 bytes of data.
  9. \   Redundant data is stored as a negative count
  10. \      followed by the byte to be repeated 1-N times.
  11. \
  12. \ MODIFIED packing coding in original Phil Burk file
  13. \ uses ASM parser to analyze data
  14. \ with about 4 times speed increase
  15. \ Author: Martin Kees
  16. \ Copyright 1991 Martin Kees
  17. \ All Rights reserved
  18. \
  19. \ 00001 PLB 1/26/92 Changed stack diagram of ILBM.MAKE.BODY to match 2.0
  20. \
  21. decimal
  22. exists? includes
  23. .IF  getmodule includes
  24. .ELSE include? bm_rows ji:graphics/gfx.j
  25. .THEN
  26. include? { ju:locals
  27.  
  28. ANEW TASK-PACKING
  29.  
  30.  
  31. .need cmoveq
  32. ASM cmoveq  ( from to len --- , LEN must be less than 32768 )
  33.     move.l  (dsp)+,a0
  34.     move.l  (dsp)+,a1
  35.     add.l   org,a0
  36.     add.l   org,a1
  37.     bra.s   2$
  38. 1$: move.b  (a1)+,(a0)+
  39. 2$: dbra.w  tos,1$
  40.     move.l  (dsp)+,tos
  41.     forth{  both }
  42. end-code
  43. .THEN
  44.  
  45. \ SameCount = # identical to first byte in buff
  46.  
  47. \ Diffcount considers a run of length 2 as different bytes if bounded
  48. \ at end by diffs
  49.  
  50. ASM CountSD ( buff length -- SameCount DiffCount )
  51.     move.l  (dsp),a0
  52.     adda.l  a4,a0       \ buffabsaddr in a0
  53.     subq.l  #1,d7       \ len-1 to d7
  54.     move.l  d7,d0       \       and  d0
  55.     move.l  d0,d1       \       and  d1
  56.     moveq.l #0,d2
  57.     move.b  (a0),d4           \ get first byte in d4
  58. 1$: addq.l  #1,d2             \ bump same cnt in d2
  59.     cmp.b   0(a0,d2.w),d4
  60.     dbne.w  d0,1$             \ if same as first byte then loop to 1$
  61.     cmp.l   #1,d2
  62.     beq.s   7$
  63.     moveq.l #1,d7
  64.     bra.s   5$                \ if sames > 1 then exit with diff=1
  65. 7$: moveq.l #1,d7             \ init diffcount to 1 again to set ne flag
  66.     bra.s   6$
  67. 2$: move.b  0(a0,d7.w),d3
  68.     addq.l  #1,d7
  69.     cmp.b   d3,d4
  70.     exg.l   d3,d4
  71. 6$: dbeq.w  d1,2$
  72.     bne.s   5$               \ ne means at max so done
  73.     tst.l   d1
  74.     bne.s   3$               \ ne means NOT at last byte
  75.     bra.s   5$               \ last 2 were = so include in diff run cnt
  76. 3$: cmp.b   0(a0,d7.w),d4    \ is it just a 2 run?
  77.     bne.s   6$               \ ne means yeah it was just 2
  78.     subq.l  #2,d7            \ oops counted 2 too many
  79. 5$: move.l  d2,(dsp)
  80. END-CODE
  81.  
  82.  
  83. 0 value vbuffsize
  84. 0 value vbuff
  85. 0 value vfile
  86.  
  87. : vflush ( -- ) \ does NOT reset vbuff pointers just writes
  88.     \ current contents
  89.     vfile vbuff dup freebyte fwrite drop
  90. ;
  91.  
  92. : vemit ( byte -- )
  93.     vbuff freebyte vbuffsize <
  94.     IF  vbuff dup freebyte + c!
  95.         1 vbuff freebytea +!
  96.     ELSE
  97.         vflush
  98.         vbuff c!
  99.         1 vbuff freebytea !
  100.     THEN
  101. ;
  102.  
  103. : vwrite { addr cnt -- }
  104.     vbuff freebyte cnt + vbuffsize <
  105.     IF addr vbuff dup freebyte + cnt cmoveq
  106.         cnt vbuff freebytea +!
  107.     ELSE
  108.         vflush
  109.         addr vbuff cnt cmoveq
  110.         cnt vbuff freebytea !
  111.     THEN
  112. ;
  113.  
  114. : vclose ( -- )
  115.     vflush
  116.     vbuff freeblock
  117.     0 -> vbuff
  118. ;
  119.  
  120. : vopen ( openedfilehandle buffsize -- Flag )
  121.     dup -> vbuffsize
  122.     memf_public swap allocblock
  123.     -> vbuff
  124.     -> vfile
  125.     vbuff
  126. ;
  127.  
  128. \ vopen is called prior to this and vclose after last row
  129. : vpackrow { row len -- }
  130.     BEGIN
  131.         len
  132.     WHILE
  133.         row len 128 min countsd
  134.         ddup
  135.         > IF  \ do a dups run
  136.  
  137.             drop
  138.             dup>r 1- negate 255 and vemit
  139.             row c@ vemit
  140.         ELSE \ do a diff run
  141.             nip
  142.             dup>r 1- vemit
  143.             row r@ vwrite
  144.         THEN
  145.         row r@ + -> row
  146.         len r> - -> len
  147.     REPEAT
  148. ;
  149.  
  150. : vcopyrow ( row len -- )
  151.     even-up vwrite
  152. ;
  153.  
  154.  
  155. \ Compression = 1 is Run length encoded.
  156. \ Compression = 0 is uncompressed.
  157.  
  158. : WRITE.BITMAP.BODY  { bmap ifffile compr | bodystart -- bodysize | error=0 }
  159.     compr 0= compr 1 = OR 0=
  160.     IF ." Illegal compression = " compr . 0 exit
  161.     THEN
  162.     ifffile 2048 vopen
  163.     IF
  164.     ifffile 0 offset_current fseek -> bodystart
  165.     bmap ..@ bm_rows 0  ( for each row )
  166.     DO bmap ..@ bm_depth 0 ( for each plane )
  167.     DO
  168. \ next plane base
  169.         bmap .. bm_planes i cells + @ >rel ( src )
  170. \ offset to row
  171.         j bmap ..@ bm_bytesperrow * +
  172.         bmap ..@ bm_bytesperrow
  173.         ( cur-row-addr  width -- )
  174.             compr 0=
  175.             IF   vcopyrow
  176.             ELSE vpackrow
  177.             THEN
  178.         LOOP
  179.         LOOP
  180.         vclose
  181.         ifffile 0 offset_current fseek bodystart -
  182.     ELSE
  183.         0  \ Couldn't allocate vbuff
  184.     THEN
  185. ;
  186.  
  187. \ This  word is used if you want access to packed BODY data
  188. \ Writing files uses WRITE.BITMAP.BODY
  189. : ILBM.MAKE.BODY ( bmap compr --  bodyptr bodysize | -1 )
  190. { bmap compr | bfile bodysize bodyptr --  bodyptr bodysize | -1 }
  191.     new " ram:tempbmap" $fopen -> bfile
  192.     bfile
  193.     IF
  194.         bmap bfile compr write.bitmap.body
  195.         dup -> bodysize
  196.         IF
  197.             memf_public bodysize
  198.             allocblock dup -> bodyptr
  199.             IF
  200.                 bfile 0 offset_begining fseek drop
  201.                 bfile bodyptr bodysize fread drop
  202.                 bodyptr bodysize
  203.             ELSE
  204.                 -1
  205.             THEN
  206.         ELSE
  207.             -1
  208.         THEN
  209.         bfile fclose
  210.         " delete ram:tempbmap quiet" $dos
  211.     ELSE
  212.         -1
  213.     THEN
  214. ;
  215.  
  216. \ This is the same as in PACKING_OLD
  217. : CTABLE>CMAP { ctable cmap #entries -- , pack }
  218. \ Convert Color Table data (2 bytes/RGB) to colorMap.
  219.     #entries 0
  220.     DO  ( -- ct cm )
  221.         ctable w@    ( next ctable value )
  222.         2 ctable + -> ctable
  223.     3 0
  224.     DO  dup
  225.         $ 0F and
  226.     4 ashift cmap 2 i - + c!
  227.         -4 ashift
  228.     LOOP drop
  229.     3 cmap + -> cmap
  230.     LOOP
  231. ;
  232.  
  233.